
 1000  *SAVE S.URSCHEL'S COLOR PATTERN
 1010  *--------------------------------
 1020  *   RODS COLOR PATTERN
 1030  *   RE-WRITTEN BY BOB URSCHEL
 1040  *   USING THE QWERTY Q68 MC68000 MPU
 1045  *
 1047         .OR     $1000
 1050         MOVE.L  #$1100,A0  MOVE PROGRAM TO FAST MEMORY
 1060         MOVE.L  #$18600,A1
 1070         MOVE    #END-START,D1
 1080  XFER   MOVE.B  (A0)+,(A1)+
 1090         DBF     D1,XFER
 1095         JMP     $18600
 1100  *
 1110  *--------------------------------
 1120  *
 1140         .OR     $18600
 1150         .TA     $1100
 1160  START
 1170         TST.B   $C050     >GR
 1180         BSR     CLRSCR    CLEAR SCREEN
 1190  *--------------------------------
 1200  START.W
 1210         MOVE.B  #3,W      >FOR W = 3 TO 50
 1220  START.I
 1230         MOVEQ   #1,D7     >FOR I = 1 TO 19
 1240  START.J
 1250         MOVEQ   #0,D3     >FOR J = 0 TO 19
 1260  SET.K  MOVE    D7,D6     >K = I + J
 1270         ADD.B   D3,D6
 1280  *--------------------------------
 1290         MOVEQ   #0,D0     >COLOR = J*3/(I+3)+I*W/12
 1300         MOVE    D3,D0
 1310         MULU    #3,D0     J*3
 1320         MOVEQ   #0,D1
 1330         MOVE    D7,D1
 1340         ADDQ    #3,D1     I+3
 1350         DIVU    D1,D0     J*3/(I+3) --> D0
 1360         MOVE    D7,D1
 1370         MOVEQ   #0,D2
 1380         MOVE.B  W,D2
 1390         MULU    D1,D2     I*W --> D2
 1400         DIVU    #12,D2    D2 / 12
 1410         ADD     D0,D2
 1420         ANDI.B  #$F,D2
 1430         MOVE.B  D2,COLOR  SET COLOR
 1440  *
 1450  *
 1460  *  SUBTRACT I AND K FROM 40
 1470  *
 1480         MOVEQ   #40,D5
 1490         SUB     D7,D5     D5 = 40 - I
 1500         MOVEQ   #40,D4
 1510         SUB     D6,D4     D4 = 40 - K
 1520         MOVE    D7,D0     >PLOT I,K
 1530         MOVE    D6,D1
 1540         BSR.S   PLOT
 1550         MOVE    D6,D0     >PLOT K,I
 1560         MOVE    D7,D1
 1570         BSR.S   PLOT
 1580         MOVE    D5,D0     >PLOT 40-I,40-K
 1590         MOVE    D4,D1
 1600         BSR.S   PLOT
 1610         MOVE    D4,D0     >PLOT 40-K,40-I
 1620         MOVE    D5,D1
 1630         BSR.S   PLOT
 1640         MOVE    D6,D0     >PLOT K,40-I
 1650         MOVE    D5,D1
 1660         BSR.S   PLOT
 1670         MOVE    D5,D0     >PLOT 40-I,K
 1680         MOVE    D6,D1
 1690         BSR.S   PLOT
 1700         MOVE    D7,D0     >PLOT I,40-K
 1710         MOVE    D4,D1
 1720         BSR.S   PLOT
 1730         MOVE    D4,D0     >PLOT 40-K,I
 1740         MOVE    D7,D1
 1750         BSR.S   PLOT
 1760         ADDQ    #1,D3     >NEXT J
 1770         CMPI    #20,D3
 1780         BNE     SET.K
 1790         ADDQ    #1,D7     >NEXT I
 1800         CMPI    #20,D7
 1810         BNE     START.J
 1820         ADDQ.B  #1,W      >NEXT W
 1830         CMPI.B  #51,W
 1840         BEQ     START.W
 1850         BNE     START.I
 1860  *
 1870  *--------------------------------
 1880  *      PLOT SUBROUTINE
 1890  *
 1900  *      A0 = SCREEN ADDRESS
 1910  *      D0 = X-COORD
 1920  *      D1 = Y-COORD
 1930  *      D2 = WORK REGISTER
 1940  *
 1950  PLOT   MOVE    D0,A0     SAVE X-COORD
 1960         LSR.B   #1,D1     GET CARRY
 1970         MOVE    SR,D0     SAVE ODD-EVEN STATUS
 1980         BSR.S   GBASCALC
 1990         ADD     D1,A0     FINAL SCREEN ADDR
 2000         MOVE.B  #$F0,MASK
 2010         MOVE.B  COLOR,D1
 2020         MOVE    D0,CCR    ODD OR EVEN?
 2030         BCC.S   PLOT1     EVEN...
 2040         MOVE.B  #$F,MASK
 2050         LSL.B   #4,D1     ROTATE COLOR
 2060  PLOT1  MOVE.B  (A0),D2   ORIGINAL BYTE
 2070         AND.B   MASK,D2   MASK OUT OLD COLOR
 2080         OR.B    D1,D2      AND GET NEW COLOR
 2090         MOVE.B  D2,(A0)   PLOT TO SCREEN
 2100         MOVEQ   #0,D0     CLEAR OUT CCR
 2110         MOVEQ   #0,D1
 2120         RTS
 2130  *
 2140  *      CALCULATE BASE ADDRESS
 2150  *
 2160  GBASCALC
 2170         MOVE    D1,D2     000DEFGH
 2180         AND.B   #$18,D1   000DE000
 2190         LSL.B   #5,D2     FGH00000
 2200         OR.B    D2,D1     FGHDE000
 2210         MOVE.B  D1,D2
 2220         AND.B   #$18,D2   000DE000
 2230         LSR.B   #2,D2     00000DE0
 2240         OR.B    D2,D1     FGHDEDE0
 2250         OR      #$100,D1 1FGHDEDE0
 2260         LSL     #2,D1  1FGHDEDE000
 2270         RTS
 2280  *
 2290  *      CLEAR LORES SCREEN
 2300  *
 2310  CLRSCR CLR     D0
 2320         MOVE    #511,D1   # OF WORDS TO MOVE MINUS 1
 2330         MOVE    #$800,A0  ENDING SCREEN ADDR
 2340  .1     MOVE    D0,-(A0)
 2350         DBF     D1,.1
 2360         RTS
 2370  *--------------------------------
 2380  *      WORK AND STORAGE
 2390  *
 2400  MASK   .BS     1
 2410  COLOR  .BS     1
 2420  W      .BS     1
 2430  *
 2440  *--------------------------------
 2450  END
 2460         .OR     $800
 2470         .DA     $18800
 2480         .DA     $1000

